Network CD 2/Network CD - Volume 2.iso/programs/internet/tcp/server/amislate1.1.lha/AmiSlate/SlateRexx/chess.rexx

OS/2 REXX Batch file | 1995-03-24 | 37.7 KB | 1,261 lines

/* Chess for AmiSlate v1.0! */

/* Constants for use with AmiSlate's ARexx interface */
AMode.DOT      =  0
AMode.PEN      =  1
AMode.LINE     =  2
AMode.CIRCLE   =  3
AMode.SQUARE   =  4
AMode.POLY     =  5
AMode.FLOOD    =  6
AMode.DTEXT    =  7

AMessage.TIMEOUT     = 1    /* No events occurred in specified time period */
AMessage.MESSAGE     = 2    /* Message recieved from remote Amiga */
AMessage.MOUSEDOWN   = 4    /* Left mouse button press in drawing area */
AMessage.MOUSEUP     = 8    /* Left mouse button release in drawing area */
AMessage.RESIZE      = 16    /* Window was resized--time to redraw screen? */
AMessage.QUIT        = 32    /* AmiSlate is shutting down */
AMessage.CONNECT     = 64    /* Connection established */
AMessage.DISCONNECT  = 128    /* Connection broken */
AMessage.TOOLSELECT  = 256    /* Tool Selected */
AMessage.COLORSELECT = 512    /* Palette Color selected */
AMessage.KEYPRESS    = 1024    /* Key pressed */

ACTIVE  = 1
PASSIVE = 0

/* Chess specific constants */
GlobData.HILITEPEN = 2
GlobData.SQUAREPEN1 = 3        /* It would probably be better to get these */
GlobData.SQUAREPEN2 = 4        /* dynamically, wouldn't it? */
GlobData.SIDE1PEN   = 2
GlobData.SIDE2PEN   = 1
GlobData.moverr = "No error"

piece.BLANK  = 0
piece.PAWN   = 1
piece.ROOK   = 2
piece.KNIGHT = 4
piece.BISHOP = 8
piece.QUEEN  = 16
piece.KING   = 32

/* Defaults */
BInitialSquareSet = 0

/* Get our host's name--always given as first argument when run from Amislate */
parse arg CommandPort ActiveString

if (length(CommandPort) == 0) then do
    say ""
    say "Usage:  rx chess.rexx <REXXPORTNAME>"
    say "        (REXXPORTNAME is usually AMISLATE)"
    say ""
    say "Or run from the Rexx menu within AmiSlate."
    say ""
    exit 0
    end

/* Send all commands to this host */
address (CommandPort)
options results

/* Reserves pixels for a future toolbar -- currently, none */
GlobData.ToolBarHeight = 0

/* Check to see which tool is selected, whether we are connected */
GlobData.BFlood = 0
GetStateAttrs stem stateattrs.

if (stateattrs.mode > 1) then GlobData.BFlood = 1

/* Parse command line argument to see if we've been activated by
   a remote request or a local user */
check = upper(left(ActiveString,3))
if (upper(left(ActiveString,3)) ~= 'RE') then
    do
        GlobData.BActive = 1
    end
    else
    do
        GlobData.BActive = 0
    end

/* See if we're connected */
GetRemoteStateAttrs stem rstateattrs.

if (rstateattrs.mode > -1) then
    do
        GlobData.BConnectMode = 1
    end
    else
    do
        GlobData.BConnectMode = 0
    end

'lock on'            /* keep user from drawing */
'lockpalette on'        /* match colors, if possible */

success = InitChessArray()

/* Initiator goes first */
GlobData.turn = ACTIVE


/* Handshaking for two-computer game */
if (GlobData.BConnectMode = 1) then
do
    if (GlobData.BActive == 1) then
    do
        SetWindowTitle '"'||"Requesting game from remote user"||'"'
    RemoteRexxCommand '"'||"Would you like to play chess?"||'"' "slaterexx:chess.rexx"

        waitevent stem handshake. MESSAGE
        if (handshake.message == 0) then
        do
            SetWindowTitle '"'||"Chess Game Refused"||'"'
            exit
        end
    success = DrawChessBoard()
    SetRemoteWindowTitle '"'||"Their turn (White)"||'"'
    end
    else
    do
        /* Examine window to get dimensions */
    GetWindowAttrs stem winattrs.
       GlobData.BoardWidth = winattrs.width  - 58
       GlobData.BoardHeight= winattrs.height - 53 - GlobData.ToolBarHeight
    end
end
else
do
    success = DrawChessBoard()
end

/* If we're in line mode, tell the remote client */
if (GlobData.BActive == 1) then sendmessage "*****"||GlobData.BFlood



success = UpdateStatus()
do while(1)
    waitevent stem event. RESIZE MOUSEDOWN MOUSEUP TOOLSELECT MESSAGE DISCONNECT

    if (event.type == AMessage.DISCONNECT) then GlobData.BConnectMode = 0
    if (event.type == AMessage.QUIT) then exit
    if (event.type == AMessage.RESIZE) then do
        if ((GlobData.BActive == 1)|(GlobData.BConnectMode == 0)) then do
           success = DrawChessBoard()
        end
        else do
           /* Just examine window to get new dimensions */
           GetWindowAttrs stem winattrs.
           GlobData.BoardWidth = winattrs.width  - 58
           GlobData.BoardHeight= winattrs.height - 53 - GlobData.ToolBarHeight
        end
             success = UpdateStatus()
    end

    if (event.type == AMessage.MESSAGE) then do
        success = ParseMove(event.message)
        if (success == 1) then do
             GlobData.turn = GlobData.BActive
             success = UpdateStatus()
             end
        end

    if ((event.type = AMessage.TOOLSELECT)&(GlobData.BActive == 1)) then do
        BOldFlood = GlobData.BFlood
        if (event.code1 < 1) then GlobData.BFlood = 0
        if (event.code1 >= 1) then GlobData.BFlood = 1
        if ((event.code1 = 7)|(GlobData.BFlood ~= BOldFlood)) then do
            success = DrawChessBoard()
            sendmessage "*****"||GlobData.BFlood
            end
        end

    if (((event.type = AMessage.MOUSEDOWN)|((event.type = AMessage.MOUSEUP)&(BInitialSquareSet = 1)))&((GlobData.turn = GlobData.BActive)|(GlobData.BConnectMode = 0))) then do
        xtemp = event.x
        SelectChessSquareX = -1
        do while (xtemp > 0)
            xtemp = xtemp - trunc(GlobData.BoardWidth / 8)
            SelectChessSquareX = SelectChessSquareX + 1
            end
        ytemp = event.y
        SelectChessSquareY = -1
        do while (ytemp > GlobData.ToolBarHeight)
            ytemp = ytemp - trunc(GlobData.BoardHeight / 8)
            SelectChessSquareY = SelectChessSquareY + 1
            end

        ThisSquare = ChessBoard.SelectChessSquareX.SelectChessSquareY
        if (((GlobData.turn == ACTIVE)&(ThisSquare > 0))|((GlobData.turn == PASSIVE)&(ThisSquare < 0))|(BInitialSquareSet == 1)) then do

               /* HiLite selected square */
            success = SelectChessSquare(SelectChessSquareX, SelectChessSquareY, GlobData.HILITEPEN)

             if (BInitialSquareSet = 0) then do
                BInitialSquareSet = 1
                SelectedSquareX = SelectChessSquareX
                SelectedSquareY = SelectChessSquareY
                end
            else do
                /* De-HiLite old square */
                sqc = SquareColor(SelectedSquareX, SelectedSquareY)
                success = SelectChessSquare(SelectedSquareX, SelectedSquareY, sqc)

                /* De-HiLite this square--move done! */
                sqc = SquareColor(SelectChessSquareX, SelectChessSquareY)
                success = SelectChessSquare(SelectChessSquareX,SelectChessSquareY, sqc)

                BInitialSquareSet = 0

            GlobData.moverr = "No error"

            moveResult = MovePiece(SelectedSquareX, SelectedSquareY, SelectChessSquareX, SelectChessSquareY)
            if (moveResult > 0) then do
                    szSendString = "1" || selectedSquareX || SelectedSquareY || SelectChessSquareX || SelectChessSquareY || moveResult
                    sendmessage szSendString
                    if (GlobData.turn == 1) then do
                        GlobData.turn = 0
                        end
                    else do
                        GlobData.turn = 1
                        end
                    success = UpdateStatus()
                    end
                else do
                    SetWindowTitle '"'||"Error: "|| GlobData.moverr || '"'
                    DisplayBeep
                    end
                end
            end
        end
    end
exit



/* --------------------------------------------------------------- */
/* procedure MovePiece                           */
/* --------------------------------------------------------------- */
MovePiece: procedure expose ChessBoard. piece. PiecePosX. PiecePosY. GlobData.
    parse arg OldX, OldY, X, Y

    if (CheckMove(OldX, OldY, X, Y, 1) == 0) then do
        return 0
        end

    /* Special case for castling--king moves to earlier square */
    if (abs(ChessBoard.OldX.OldY) == Piece.King) then do
        if ((OldX == 3)&(X == 0)) then X = 1
        if ((OldX == 3)&(X == 7)) then X = 6
        end

    if (UpdatePiecePos(OldX, OldY, X, Y) == 0) then do
        EasyRequest Chess_Error "555:UPP_failed" Okay
        return 0
        end

    /* Was there a death here?  If so, remove dying piece */
    if (ChessBoard.X.Y ~= Piece.BLANK) then do
        VictimPiece = GetPiecePos(X, Y)
        if (VictimPiece > 0) then do
            PiecePosX.1.VictimPiece = 9999
            PiecePosY.1.VictimPiece = 9999
            end
        else do
            VictimPiece = abs(VictimPiece)
            PiecePosX.2.VictimPiece = 9999
            PiecePosY.2.VictimPiece = 9999
            end
        end

    returnresult = 1

    /* Check for pawn promotion */
    if (((Y == 7)&(ChessBoard.OldX.OldY == Piece.PAWN))|((Y == 0)&(ChessBoard.OldX.OldY == -Piece.PAWN))) then do
            if (ChessBoard.OldX.OldY = Piece.PAWN) then do
                tSide = 1
                end
            else do
                tSide = -1
            end

            EasyRequest '"'||"Your pawn is getting a promotion!"||'"' '"'||"What do you want to promote your pawn to?"||'"' "Queen|Rook|Bishop|Knight"
        if (rc == 0) then ChessBoard.OldX.OldY = tSide * Piece.Knight
        if (rc == 1) then ChessBoard.OldX.OldY = tSide * Piece.Queen
        if (rc == 2) then ChessBoard.OldX.OldY = tSide * Piece.Rook
        if (rc == 3) then ChessBoard.OldX.OldY = tSide * Piece.Bishop
        returnresult = rc + 2    /* For transmission */
    end

    ChessBoard.X.Y = ChessBoard.OldX.OldY              /* Then put the piece in the new spot! */
    ChessBoard.OldX.OldY = Piece.BLANK

    success=DrawPiece(OldX, OldY, ChessBoard.OldX.OldY, GlobData.BFlood)
    success=DrawPiece(X, Y, ChessBoard.X.Y, GlobData.BFlood)

    return returnresult


/* --------------------------------------------------------------- */
/* procedure MoveCreatesCheck                           */
/*                                   */
/* This procedure will determine if the move (OldX,OldY)->(X,Y)    */
/* will get the piece at CheckX, CheckY into danger (i.e. check    */
/* for a king, etc. ) without affecting the board              */
/* --------------------------------------------------------------- */
MoveCreatesCheck: procedure expose ChessBoard. piece. PiecePosX. PiecePosY.
    parse arg OldX, OldY, X, Y, CheckX, CheckY

    if (ChessBoard.OldX.OldY == Piece.BLANK) then do
        EasyRequest Chess_Error "MoveCreatesCheck:_Bad_Attacker!" Okay
        return 1
        end

    AttackerPiece = ChessBoard.OldX.OldY
    AttackerID = GetPiecePos(OldX, OldY)
    if (AttackerID == 0) then do
        EasyRequest Chess_Error "MoveCreatesCheck:_Anonymous_Attacker!" Okay
        return 1
        end
    if (AttackerID < 0) then do
        AttackerID = abs(AttackerID)
        nAttackerSide = 2
        end
    else do
        nAttackerSide = 1
        end

    TargetPiece = ChessBoard.X.Y
    TargetID    = 0            /* Default = unset/error */
    if (TargetPiece ~= Piece.BLANK) then do
    TargetID = GetPiecePos(X,Y)
    if (TargetID == 0) then do
        EasyRequest Chess_Error "MoveCreatesCheck:_Anonymous_defender!" Okay
        return 1
        end
    if (TargetID < 0) then do
        TargetID = abs(TargetID)
        nTargetSide = 2
        end
    else do
        nTargetSide = 1
        end
    PiecePosX.nTargetSide.TargetID = 9999
    PiecePosY.nTargetSide.TargetID = 9999
    end

    /* Move the attacker, on both arrays */
        PiecePosX.nAttackerSide.AttackerID = X
        PiecePosY.nAttackerSide.AttackerID = Y
    ChessBoard.X.Y = AttackerPiece              /* Then put the piece in the new spot! */

    /* Erase the attacker from his old position */
    ChessBoard.OldX.OldY = Piece.BLANK

    /* Now see if we have a check situation */
    returnFlag = IsInCheck(CheckX,CheckY)

    /* Clean up from our little sim -- move piece back and replace victim */
    ChessBoard.OldX.OldY = AttackerPiece
    PiecePosX.nAttackerSide.AttackerID = OldX
    PiecePosY.nAttackerSide.AttackerID = OldY

    ChessBoard.X.Y = TargetPiece
    if (TargetID ~= 0) then do
        PiecePosX.nTargetSide.TargetID = X
        PiecePosY.nTargetSide.TargetID = Y
        end

    return ReturnFlag



/* --------------------------------------------------------------- */
/* procedure UpdatePiecePos                               */
/* --------------------------------------------------------------- */
UpdatePiecePos: procedure expose ChessBoard. PiecePosX. PiecePosY.
    parse arg OldX, OldY, X, Y

    ThisPiece = GetPiecePos(OldX, OldY)

    if (ThisPiece == 0) then do
        EasyRequest Chess_Error "UpdatePiecePos:update_empty_square?_huh?" Okay
        return 0
        end

    if (ThisPiece > 0) then do
        PiecePosX.1.ThisPiece = X
        PiecePosY.1.ThisPiece = Y
        return 1
        end
    else do
        ThisPiece = abs(ThisPiece)
        PiecePosX.2.ThisPiece = X
        PiecePosY.2.ThisPiece = Y
        return 1
        end

    EasyRequest Chess_Error "UpdatePiecePos_error-not_found" Okay
    return 0




/* --------------------------------------------------------------- */
/* procedure GetPiecePos                              */
/*                                   */
/* Given a set of co-ordinates, this function returns the PiecePos */
/* index/ID of the piece there.  Positive values is for Side1 (top */
/* and negative values are for side2 (bottom).  0 = blank/error.   */
/* --------------------------------------------------------------- */
GetPiecePos: procedure expose PiecePosX. PiecePosY. ChessBoard.
    parse arg X, Y

    if ((ChessBoard.X.Y == 0)|(X < 0)|(X > 7)|(Y < 0)|(Y > 7)) then return 0

    if (ChessBoard.X.Y > 0) then do
        pi = 1
        do while (pi < 17)
            if ((PiecePosX.1.pi == X)&(PiecePosY.1.pi == Y)) then do
                return pi
                end
            pi = pi + 1
            end
        end
    else do
        pi = 1
        do while (pi < 17)
            if ((PiecePosX.2.pi == X)&(PiecePosY.2.pi == Y)) then do
                return -pi
                end
            pi = pi + 1
            end
        end
    return 0


/* --------------------------------------------------------------- */
/* procedure InternalMove                          */
/*                                   */
/* Updates all necessary piece movement vars in memory only        */
/*                                   */
/* --------------------------------------------------------------- */
InternalMove: procedure expose ChessBoard. piece. PiecePosX. PiecePosY.
    parse arg XFrom, YFrom, XTo, YTo

    if (UpdatePiecePos(XFrom, YFrom, XTo, YTo) == 0) then do
        EasyRequest Chess_Error "997:UPP_failed" Okay
        return 0
        end
    ChessBoard.XTo.YTo = ChessBoard.XFrom.YFrom
    ChessBoard.XFrom.YFrom = Piece.BLANK
    return 1



/* --------------------------------------------------------------- */
/* procedure CastleOkay                          */
/*                                   */
/* returns 1 if the castling move is okay, else zero                */
/*                                   */
/* --------------------------------------------------------------- */
CastleOkay: procedure expose ChessBoard. piece. PiecePosX. PiecePosY. GlobData.
    parse arg XFrom, YFrom, XTo, YTo

    GlobData.moverr = "Can't castle from there"

    /* Only can castle from King's starting position */
    if (XFrom != 3) then do
        GlobData.moverr = "Can't castle after king has moved"
        return 0
        end

    if (YFrom != YTo) then return 0

    /* First thing: determine what side we're on */
    if (ChessBoard.XFrom.YFrom < 0) then do
        SideToCheck = 2
        if (YFrom != 7) then return 0
        end
    else do
        SideToCheck = 1
        if (YFrom != 0) then return 0
        end

    /* can't castle if king has already moved */
    if (ChessBoard.KingMoved.SideToCheck == 1) then do
        GlobData.moverr = "Can't castle after king has moved"
        return 0
        end

    LeftOrRight = 0            /* Default = error */
    if (XTo == 0) then do
        LeftOrRight = 1        /* Left */
        NewRookX = 2
        NewKingX = 1
        /* Can't castle if rook has moved */
        if (ChessBoard.LeftRookMoved.SideToCheck == 1) then do
            GlobData.moverr = "Can't castle after rook has moved"
            return 0
            end
        end
    if (XTo == 7) then do
        LeftOrRight = 2     /* Right */
        NewRookX = 5
        NewKingX = 6
        /* Can't castle if rook has moved */
        if (ChessBoard.RightRookMoved.SideToCheck == 1) then do
            GlobData.moverr = "Can't castle after rook has moved"
            return 0
            end
        end
    if (LeftOrRight == 0) then do
        GlobData.moverr = "You should never see this error"
        return 0    /* This should never happen */
        end

    /* Make sure all spaces between king and rook are clear */
    if (GlideOK(XFrom,YFrom,XTo,YTo) == 0) then do
        GlobData.moverr = "There are pieces between king and rook"
        return 0
        end

    /* Can't castle out of check */
    if (IsInCheck(XFrom,YFrom) == 1) then do
        GlobData.moverr = "Can't castle out of check"
        return 0
        end

    /* Move rook to new position, in my head anyway */
    if (InternalMove(XTo, YTo, newRookX, YTo) == 0) then return 0

    /* Move king to new position, in my head anyway */
    if (InternalMove(XFrom, YFrom, newKingX, YFrom) == 0) then return 0

    /* See if this causes check */
    if (IsInCheck(newKingX,YFrom) == 1) then do
        /* oops, would be a move into check.  No can do! */
        /* So move everything back! */

        /* Move rook back to old position, in my head anyway */
        if (InternalMove(newRookX, YTo, XTo, YTo) == 0) then return 0

        /* Move king back to old position, in my head anyway */
        if (InternalMove(newKingX, YFrom, XFrom, YFrom) == 0) then return 0

        GlobData.moverr = "Can't castle into check"

        /* and fail */
        return 0
        end

    /* If we're here, then the castle is acceptable.  Put the king
       back for now--it'll be moved by the normal turn--but we'll
       move the rook ourselves! */

    /* Move king back to old position, in my head anyway */
    if (InternalMove(newKingX, YFrom, XFrom, YFrom) == 0) then return 0

    /* Display and transmit the rook's move */

    /* Erase old rook */
    success = DrawPiece(XTo, YTo, ChessBoard.XTo.YTo, GlobData.BFlood)

    /* Draw new rook */
    success = DrawPiece(newRookX, YTo, ChessBoard.newRookX.YTo, GlobData.BFlood)

    /* Transmit move -- 2 means don't lose turn yet */
    szSendString = "2" || XTo || YTo || newRookX || YTo || "0"
        sendmessage szSendString

    return 1


/* --------------------------------------------------------------- */
/* procedure CheckMove                          */
/* --------------------------------------------------------------- */
CheckMove: procedure expose ChessBoard. piece. PiecePosX. PiecePosY. GlobData.
    parse arg XFrom, YFrom, XTo, YTo, BCheckForCheck

    /* A move off of the board is illegal */
    if ((XTo < 0)|(XTo > 7)|(YTo < 0)|(YTo > 7)) then do
        GlobData.moverr = "Can't move off of board"
        return 0
        end

    /* A move from off of the board is illegal */
    if ((XFrom < 0)|(XFrom > 7)|(YFrom < 0)|(YFrom > 7)) then do
        GlobData.moverr = "Can't move from off of board"
        return 0
        end

    /* Blanks can't move */
    if (ChessBoard.XFrom.YFrom == Piece.BLANK) then do
        GlobData.moverr = "Can't move a blank square"
        return 0
        end


    /* A move to the same spot we're on is illegal */
    if ((XFrom == XTo)&(YFrom == YTo)) then do
        GlobData.moverr = "Can't move onto yourself"
        return 0
        end

    /* A move onto one of your own pieces is illegal */
    if ((ChessBoard.XTo.YTo * ChessBoard.XFrom.YFrom) > 0) then do
        /* except when you're castling */
        if (((ChessBoard.XTo.YTo == Piece.Rook)&(ChessBoard.XFrom.YFrom == Piece.King))|((ChessBoard.XTo.YTo == -Piece.Rook)&(ChessBoard.XFrom.YFrom == -Piece.King))) then do
             /* nothing right now, we'll check for castling later */
             end
        else do
             GlobData.moverr = "Can't attack your own piece"
             return 0
             end
    end

    /* Rules for the PAWN */
    if (abs(ChessBoard.XFrom.YFrom) == Piece.PAWN) then do
        GlobData.moverr = "Bad pawn move"
        if (ChessBoard.XFrom.YFrom < 0) then do
            PawnMoveDir = -1
            end
            else PawnMoveDir = 1
        if ((XTo == XFrom)&(ChessBoard.XTo.YTo ~= Piece.BLANK)) then do
            GlobData.moverr = "Pawn can't attack forward"
             return 0
             end
        if ((XTo == XFrom)&(abs(YFrom - YTo) == 2)) then do
            /* First move for a pawn can be two spaces, if both spaces are blank */
            Ytemp = YFrom+PawnMoveDir
            if ((ChessBoard.XFrom.Ytemp) ~= Piece.BLANK) then return 0
            if ((YFrom == 1)&(PawnMoveDir ~= 1)) then return 0
            if ((YFrom == 6)&(PawnMoveDir ~= -1)) then return 0
            if ((YFrom ~= 1)&(YFrom ~= 6)) then return 0
            end
        else do
            if (YTo ~= (YFrom + PawnMoveDir)) then return 0
            if (abs(XFrom - XTo) > 1) then return 0
            if ((abs(XFrom - XTo) == 1)&(ChessBoard.XTo.YTo == Piece.BLANK)) then return 0
            end
        end

    /* Rules for the ROOK */
    if (abs(ChessBoard.XFrom.YFrom) == Piece.ROOK) then do
        if ((XFrom ~= XTo)&(YFrom ~= YTo)) then do
            GlobData.moverr = "Rook must move horizontally or vertically"
            return 0
            end
        if (GlideOK(XFrom,YFrom,XTo,YTo) == 0) then do
            GlobData.moverr = "Move is blocked"
            return 0
            end
        end

    /* Rules for the KNIGHT */
    if (abs(ChessBoard.XFrom.YFrom) == Piece.KNIGHT) then do
        GlobData.moverr = "Bad knight move"
        if (((abs(XFrom - XTo) ~= 2)|(abs(YFrom - YTo) ~= 1))&((abs(XFrom - XTo) ~= 1)|(abs(YFrom - YTo) ~= 2))) then return 0
        end

    /* Rules for the BISHOP */
    if (abs(ChessBoard.XFrom.YFrom) == Piece.BISHOP) then do
        if (abs(XFrom - XTo) ~= abs(YFrom - YTo)) then do
            GlobData.moverr = "Bishop must move diagonally"
            return 0
            end
        if (GlideOK(XFrom,YFrom,XTo,YTo) == 0) then do
            GlobData.moverr = "Move is blocked"
            return 0
            end
        end

    /* Rules for the QUEEN */
    if (abs(ChessBoard.XFrom.YFrom) == Piece.QUEEN) then do
        if ((abs(XFrom - XTo) ~= abs(YFrom - YTo))&((XFrom ~= XTo)&(YFrom ~= YTo))) then do
            GlobData.moverr = "Queen must move in a straight line"
            return 0
            end
        if (GlideOK(XFrom,YFrom,XTo,YTo) == 0) then do
            GlobData.moverr = "Move is blocked"
            return 0
            end
        end

    /* Rules for the KING */
    if (abs(ChessBoard.XFrom.YFrom) == Piece.KING) then do
        if (((ChessBoard.XTo.YTo == Piece.ROOK)&(ChessBoard.XFrom.YFrom == Piece.KING))|((ChessBoard.XTo.YTo == -Piece.ROOK)&(ChessBoard.XFrom.YFrom == -Piece.KING)))
           then do
                if (CastleOkay(XFrom,YFrom,XTo,YTo) == 0) then return 0
                end
           else do
            if ((abs(XTo - XFrom) > 1)|(abs(YTo - YFrom) > 1)) then do
                GlobData.moverr = "King can only move 1 square"
                return 0
                end
           end
    end

    if (BCheckForCheck == 0) then return 1

    /* Get king's co-ordinates */
    if (Chessboard.XFrom.YFrom > 0) then do
        KingPosX = PiecePosX.1.1
        KingPosY = PiecePosY.1.1
        end
    else do
        KingPosX = PiecePosX.2.1
        KingPosY = PiecePosY.2.1
        end

    /* If king is moving, check were he WILL be, not where he IS */
    if (abs(ChessBoard.XFrom.YFrom) == Piece.KING) then do
        KingPosX = XTo
        KingPosY = YTo
        end

    if (MoveCreatesCheck(XFrom, YFrom, XTo, YTo, KingPosX, KingPosY) == 1) then do
        if (abs(ChessBoard.XFrom.YFrom) == Piece.KING) then do
                GlobData.moverr = "Move would put you in check"
            end
            else do
                GlobData.moverr = "Move does not remove you from check"
            end
        return 0
        end

    /* If we passed all these tests, we're ok */

    /* If it's a rook or a king, set the appropriate moved flag */
    if (ChessBoard.XFrom.YFrom == Piece.King) then ChessBoard.KingMoved.1 = 1
    if (ChessBoard.XFrom.YFrom == -Piece.King) then ChessBoard.KingMoved.2 = 1

    if (ChessBoard.XFrom.YFrom == Piece.Rook) then do
        if ((XFrom == 0)&(YFrom == 0)) then ChessBoard.LeftRookMoved.1 = 1
        if ((XFrom == 7)&(YFrom == 0)) then ChessBoard.RightRookMoved.1 = 1
        end
    if (ChessBoard.XFrom.YFrom == -Piece.Rook) then do
        if ((XFrom == 0)&(YFrom == 7)) then ChessBoard.LeftRookMoved.2 = 1
        if ((XFrom == 7)&(YFrom == 7)) then ChessBoard.RightRookMoved.2 = 1
        end

    return 1



/* --------------------------------------------------------------- */
/* procedure GlideOK                              */
/* --------------------------------------------------------------- */
GlideOK:    procedure expose ChessBoard. piece.
    parse arg XFrom, YFrom, XTo, YTo

    xd = 0
    yd = 0

    if ((XTo - XFrom) > 0) then xd = 1
    if ((XTo - XFrom) < 0) then xd = -1
    if ((YTo - YFrom) > 0) then yd = 1
    if ((YTo - YFrom) < 0) then yd = -1

    x = XFrom + xd    /* Start scanning after where piece already is */
    y = YFrom + yd

    xgoal = XTo
    ygoal = YTo

    do while ((x ~= xgoal)|(y ~= ygoal))
        if (ChessBoard.x.y ~= Piece.BLANK) then return 0
        if ((x<0)|(y<0)|(x>7)|(y>7)) then do
            EasyRequest Chess_Error "Glide_error!" Okay
            return 0
            end
        x = x + xd
        y = y + yd
        end

    return 1


/* --------------------------------------------------------------- */
/* procedure IsInCheck                           */
/*                                    */
/* returns 1 if the given square is in danger, otherwise 0         */
/* --------------------------------------------------------------- */
IsInCheck: procedure expose ChessBoard. PiecePosX. PiecePosY. piece.
    parse arg X, Y


    if (ChessBoard.X.Y == 0) then do
        EasyRequest Chess_Error "IsInCheck_:_Square_is_empty!" Okay
        return 0
        end

    if (ChessBoard.X.Y > 0) then SideToCheck = 2
    if (ChessBoard.X.Y < 0) then SideToCheck = 1

    pi = 1
    do while (pi < 17)
        if (CheckMove(PiecePosX.SideToCheck.pi,PiecePosY.SideToCheck.pi,X,Y,0) == 1) then return 1
        pi = pi + 1
    end
    return 0



/* --------------------------------------------------------------- */
/* procedure                                */
/* --------------------------------------------------------------- */
InitChessArray: procedure expose ChessBoard. piece. PiecePosX. PiecePosY.

   /* Set special castling info for both sides */
   ChessBoard.KingMoved.1 = 0
   ChessBoard.KingMoved.2 = 0
   ChessBoard.LeftRookMoved.1  = 0
   ChessBoard.RightRookMoved.1 = 0
   ChessBoard.LeftRookMoved.2  = 0
   ChessBoard.RightRookMoved.2 = 0

   /* Set Kings */
   ChessBoard.3.0 = Piece.KING
   ChessBoard.3.7 = -Piece.KING

   /* Set king position markers */
   PiecePosX.1.1 = 3
   PiecePosY.1.1 = 0
   PiecePosX.2.1 = 3
   PiecePosY.2.1 = 7

   /* Set Queens */
   ChessBoard.4.0 = Piece.QUEEN
   ChessBoard.4.7 = -Piece.QUEEN

   /* Set queen position markers */
   PiecePosX.1.2 = 4
   PiecePosY.1.2 = 0
   PiecePosX.2.2 = 4
   PiecePosY.2.2 = 7

   /* Set rooks */
   ChessBoard.0.0 = Piece.ROOK
   ChessBoard.7.0 = Piece.ROOK
   ChessBoard.0.7 = -Piece.ROOK
   ChessBoard.7.7 = -Piece.ROOK

   /* Set rook position markers */
   PiecePosX.1.3 = 0
   PiecePosY.1.3 = 0
   PiecePosX.1.4 = 7
   PiecePosY.1.4 = 0

   PiecePosX.2.3 = 0
   PiecePosY.2.3 = 7
   PiecePosX.2.4 = 7
   PiecePosY.2.4 = 7

   /* Set knights */
   ChessBoard.1.0 = Piece.KNIGHT
   ChessBoard.6.0 = Piece.KNIGHT
   ChessBoard.1.7 = -Piece.KNIGHT
   ChessBoard.6.7 = -Piece.KNIGHT

   /* Set knight position markers */
   PiecePosX.1.5 = 1
   PiecePosY.1.5 = 0
   PiecePosX.1.6 = 6
   PiecePosY.1.6 = 0

   PiecePosX.2.5 = 1
   PiecePosY.2.5 = 7
   PiecePosX.2.6 = 6
   PiecePosY.2.6 = 7

   /* Set bishops */
   ChessBoard.2.0 = Piece.BISHOP
   ChessBoard.5.0 = Piece.BISHOP
   ChessBoard.2.7 = -Piece.BISHOP
   ChessBoard.5.7 = -Piece.BISHOP

   /* Set bishop position markers */
   PiecePosX.1.7 = 2
   PiecePosY.1.7 = 0
   PiecePosX.1.8 = 5
   PiecePosY.1.8 = 0

   PiecePosX.2.7 = 2
   PiecePosY.2.7 = 7
   PiecePosX.2.8 = 5
   PiecePosY.2.8 = 7

   /* Set rows of pawns */
   jx = 0
   do while (jx < 8)
       ChessBoard.jx.1 = Piece.PAWN
       ppTemp = jx + 9
       PiecePosX.1.ppTemp = jx
       PiecePosY.1.ppTemp = 1
    jx = jx + 1
       end

   jx = 0
   do while (jx < 8)
    ChessBoard.jx.6 = -1        /* - means bottom team */
       ppTemp = jx + 9
       PiecePosX.2.ppTemp = jx
       PiecePosY.2.ppTemp = 6
    jx = jx + 1
    end

   /* Center of board is all blanks */
   jy = 2
   do while (jy < 6)
    jx = 0
    do while (jx < 8)
        ChessBoard.jx.jy = Piece.BLANK
        jx = jx + 1
    end
    jy = jy + 1
   end

   return 1



/* --------------------------------------------------------------- */
/* procedure DrawChessBoard                       */
/* --------------------------------------------------------------- */
DrawChessBoard: procedure expose ChessBoard. GlobData. piece.

   /* Say what we're doing */
   SetWindowTitle '"'||"Drawing Chess Board, Please Wait"||'"'
   SetRemoteWindowTitle '"'||"Drawing Chess Board, Please Wait"||'"'

   /* Examine window to get dimensions */
   GetWindowAttrs stem winattrs.
   GlobData.BoardWidth = winattrs.width  - 58
   GlobData.BoardHeight= winattrs.height - 53 - GlobData.ToolBarHeight

   /* Clear Screen */
   clear
   jy = 0
   do while (jy < 8)
    jx = 0
    do while (jx < 8)
        success = DrawPiece(jx, jy, ChessBoard.jx.jy, GlobData.BFlood)
        jx = jx + 1
    end
    jy = jy + 1
   end

   return 1

/* --------------------------------------------------------------- */
/* procedure SquareColor                                              */
/*                                                                      */
/* Given the X,Y co-ordinates (0-7,0-7) of a chess square, return  */
/* its pen color.                                                    */
/* --------------------------------------------------------------- */
SquareColor: procedure expose GlobData.
    parse arg XX, YY

if ((XX+ YY)/2) = trunc((XX + YY)/2) then
    return GlobData.SQUAREPEN1
else
    return GlobData.SQUAREPEN2


/* --------------------------------------------------------------- */
/* procedure SelectChessSquare                       */
/* --------------------------------------------------------------- */
SelectChessSquare: procedure expose GlobData.
    parse arg ChessSquareSelectX, ChessSquareSelectY, PenToSelectWith

   xleft   = trunc(GlobData.BoardWidth / 8) * ChessSquareSelectX
   ytop    = (trunc(GlobData.BoardHeight / 8) * ChessSquareSelectY) + GlobData.ToolBarHeight
   xright  = xleft + trunc(GlobData.BoardWidth / 8)
   ybottom = ytop + trunc(GlobData.BoardHeight / 8)

   setfpen PenToSelectWith
   square xleft ytop (xright-1) (ybottom-1)
   return 1


/* --------------------------------------------------------------- */
/* procedure ParseMove                           */
/* --------------------------------------------------------------- */
ParseMove: procedure expose ChessBoard. piece. PiecePosX. PiecePosY. GlobData.
    parse arg MoveString

   /* parses a move of the form MABCD0 , where
       M = checkcode, A = X1, B = Y1, C = X2, D = Y2.  No checking needs to
       be done on the move, as that will all have been done before allowing
       it to be sent */

   leftpart = left(MoveString,3)
   rightpart = right(MoveString,3)

   checkcode = left(leftpart,1)
   promcode = right(rightpart,1)

   /* Special case:  If the message is of the form *****N, then N is
      the new value for BFlood */
   if (checkcode == '*') then do
       GlobData.BFlood = promcode
       return 2    /* means stick around for another move */
       end

   /* If its my turn, then he don't get to move! */
   if (GlobData.turn == GlobData.BActive) then return 0

   leftpart = right(leftpart,2)
   rightpart = left(rightpart,2)

   mx1 = left(leftpart,1)
   my1 = right(leftpart,1)
   mx2 = left(rightpart,1)
   my2 = right(rightpart,1)

   if (UpdatePiecePos(mx1, my1, mx2, my2) == 0) then do
       EasyRequeset Chess_Error "555:_UPP_failed" Okay
       return 0
       end

   /* Was there a death here?  If so, remove dying piece */
   if (ChessBoard.mx2.my2 ~= Piece.BLANK) then do
       VictimPiece = GetPiecePos(mx2, my2)
    if (VictimPiece > 0) then do
        PiecePosX.1.VictimPiece = 9999
        PiecePosY.1.VictimPiece = 9999
        end
    else do
        VictimPiece = abs(VictimPiece)
        PiecePosX.2.VictimPiece = 9999
        PiecePosY.2.VictimPiece = 9999
        end
    end

   /* See if there was a pawn promotion on this move */
   if (promcode > 1) then do
       /* Get side code */
    if (ChessBoard.mx1.my1 > 0) then do
        tSide = 1
        end
    else do
        tSide = -1
        end
       if (promcode == 2) then ChessBoard.mx1.my1 = Piece.KNIGHT * tSide
       if (promcode == 3) then ChessBoard.mx1.my1 = Piece.QUEEN  * tSide
       if (promcode == 4) then ChessBoard.mx1.my1 = Piece.ROOK   * tSide
       if (promcode == 5) then ChessBoard.mx1.my1 = Piece.BISHOP * tSide
       say "promotion to "promcode
       end

   ChessBoard.mx2.my2 = ChessBoard.mx1.my1  /* Then put the piece in the new spot! */
   ChessBoard.mx1.my1 = Piece.BLANK

   return checkcode




/* --------------------------------------------------------------- */
/* procedure UpdateStatus                                             */
/* --------------------------------------------------------------- */
UpdateStatus: procedure expose GlobData. ACTIVE PASSIVE

    /* Say whose turn it is */
    if (GlobData.turn ~= GlobData.BActive) then LocalOrRemote = "It's Their turn"
    if ((GlobData.BConnectMode == 0)|(GlobData.turn == GlobData.BActive)) then LocalOrRemote = "It's Your turn"

    if (GlobData.turn == ACTIVE) then do
        LocalOrRemote = '"' || LocalOrRemote || " (White)" || '"'
        end
        else do
        LocalOrRemote = '"' || LocalOrRemote || " (Black)" || '"'
        end

    SetWindowTitle LocalOrRemote
    return 1



/* --------------------------------------------------------------- */
/* procedure DrawPiece                                              */
/* --------------------------------------------------------------- */
DrawPiece: procedure expose GlobData. piece.
    parse arg X, Y, PieceCode, BFlood

    /* Decode PieceCode */
    PieceColor = GlobData.SIDE1PEN

    if (PieceCode < 0) then do
        PieceCode = abs(PieceCode)
        PieceColor = GlobData.SIDE2PEN
        end

    /* Get co-ords of our square */
    xleft   = trunc(GlobData.BoardWidth / 8) * X
    ytop    = (trunc(GlobData.BoardHeight / 8) * Y) + GlobData.ToolBarHeight
    xd      = trunc(GlobData.BoardWidth / 8) - 1
    yd      = trunc(GlobData.BoardHeight/ 8) - 1
    xright  = xleft + xd
    ybottom = ytop + yd
    xcenter = (xleft + trunc(xd/2))
    ycenter = (ytop + trunc(yd/2))

    /* First thing we need to do is erase the square */
    sqc = SquareColor(X, Y)
    setfpen sqc
    square xleft ytop xright ybottom fill

    /* If we're doing a filled mode draw, then outline in the other team's color */
    if (BFlood > 0) then do
            if (PieceColor == GlobData.SIDE1PEN) then do
                OutlineColor = GlobData.SIDE2PEN
                end
            else do
                OutlineColor = GlobData.SIDE1PEN
                end
            end
            else do
                OutlineColor = PieceColor
            end

    /* Set color to appropriate side */
    setfpen OutlineColor

    if (PieceCode == piece.PAWN) then do
        penreset
        pen (xleft+trunc(xd*.56))  (ytop+trunc(yd*.47))
        pen (xleft+trunc(xd*.6))   (ytop+trunc(yd*.8))
        pen (xleft+trunc(xd*.65))  (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.35))  (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.4))   (ytop+trunc(yd*.8))
        pen (xleft+trunc(xd*.44))  (ytop+trunc(yd*.47))
        if BFlood > 0 then do
                setfpen PieceColor
                circle (xleft+trunc(xd*.5)) (ytop+trunc(yd*.38)) (trunc(xd*.16)) (trunc(yd*.16)) fill
                    setfpen OutlineColor
                    end
        circle (xleft+trunc(xd*.5)) (ytop+trunc(yd*.38)) (trunc(xd*.16)) (trunc(yd*.16))

            if BFlood > 0 then do
                setfpen PieceColor
                    flood xcenter (ytop + trunc(yd * .8))
                    end
    end
    else if (PieceCode == piece.ROOK) then do
        penreset
        pen (xleft+trunc(xd*.3))   (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.4))   (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.4))   (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.45))  (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.45))  (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.55))  (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.55))  (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.6))   (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.6))   (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.7))   (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.7))   (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.6))   (ytop+trunc(yd*.4))
        pen (xleft+trunc(xd*.6))   (ytop+trunc(yd*.7))
        pen (xleft+trunc(xd*.75))  (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.25))  (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.4))   (ytop+trunc(yd*.7))
        pen (xleft+trunc(xd*.4))   (ytop+trunc(yd*.4))
        pen (xleft+trunc(xd*.3))   (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.3))   (ytop+trunc(yd*.2))
            setfpen PieceColor
        if BFlood > 0 then flood (xleft+trunc(xd*.5)) (ytop + trunc(yd*.5))
    end
    else if (PieceCode == piece.KNIGHT) then do
        penreset
        pen (xleft+trunc(xd*.3))  (ytop+trunc(yd*.2))
            pen (xleft+trunc(xd*.3))  (ytop+trunc(yd*.10))
            pen (xleft+trunc(xd*.33)) (ytop+trunc(yd*.19))
        pen (xleft+trunc(xd*.6))  (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.7))  (ytop+trunc(yd*.4))
        pen (xleft+trunc(xd*.65)) (ytop+trunc(yd*.45))
        pen (xleft+trunc(xd*.5))  (ytop+trunc(yd*.4))
        pen (xleft+trunc(xd*.5))  (ytop+trunc(yd*.5))
        pen (xleft+trunc(xd*.6))  (ytop+trunc(yd*.6))
        pen (xleft+trunc(xd*.75)) (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.25)) (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.3))  (ytop+trunc(yd*.8))
        pen (xleft+trunc(xd*.3))  (ytop+trunc(yd*.7))
        pen (xleft+trunc(xd*.2))  (ytop+trunc(yd*.4))
        pen (xleft+trunc(xd*.3))  (ytop+trunc(yd*.2))
            setfpen PieceColor
        if BFlood > 0 then flood (xleft+trunc(xd*.5)) (ytop+trunc(yd*.75))
        setfpen OutlineColor
        circle (xleft+trunc(xd*.55)) (ytop+trunc(yd*.3)) trunc(xd/20) trunc(yd/20) fill
    end
    else if (PieceCode == piece.BISHOP) then do
        penreset
        pen (xleft+trunc(xd*.48))  (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.4))   (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.45))  (ytop+trunc(yd*.4))
        pen (xleft+trunc(xd*.35))  (ytop+trunc(yd*.7))
        pen (xleft+trunc(xd*.35))  (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.65))  (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.65))  (ytop+trunc(yd*.7))
        pen (xleft+trunc(xd*.55))  (ytop+trunc(yd*.4))
        pen (xleft+trunc(xd*.6))   (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.52))  (ytop+trunc(yd*.2))
        if BFlood > 0 then do
            setfpen PieceColor
            circle (xleft+trunc(xd*.5)) (ytop+trunc(yd*.2)) trunc(xd*.08) trunc(yd*.08) fill
            setfpen OutlineColor
            end
        circle (xleft+trunc(xd*.5)) (ytop+trunc(yd*.2)) trunc(xd*.08) trunc(yd*.08)
            if BFlood > 0 then do
                setfpen PieceColor
               flood (xleft+trunc(xd*.5)) (ytop+trunc(yd*.8))
                end
    end
    else if (PieceCode == piece.QUEEN) then do
        penreset
        pen (xleft+trunc(xd*.4)) (ytop+trunc(yd*.1))
        pen (xleft+trunc(xd*.6)) (ytop+trunc(yd*.1))
        pen (xleft+trunc(xd*.7)) (ytop+trunc(yd*.15))
        pen (xleft+trunc(xd*.6)) (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.6)) (ytop+trunc(yd*.7))
        pen (xleft+trunc(xd*.8)) (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.2)) (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.4)) (ytop+trunc(yd*.7))
        pen (xleft+trunc(xd*.4)) (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.3)) (ytop+trunc(yd*.15))
        pen (xleft+trunc(xd*.4)) (ytop+trunc(yd*.1))
            setfpen PieceColor
        if BFlood > 0 then flood (xleft+trunc(xd*.5)) (ytop + trunc(yd*.75))
    end
    else if (PieceCode == piece.KING) then do
        penreset
        pen (xleft+trunc(xd*.47)) (ytop+trunc(yd*.1))
        pen (xleft+trunc(xd*.53)) (ytop+trunc(yd*.1))
        pen (xleft+trunc(xd*.53)) (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.57)) (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.57)) (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.53)) (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.53)) (ytop+trunc(yd*.4))
        pen (xleft+trunc(xd*.6))  (ytop+trunc(yd*.5))
        pen (xleft+trunc(xd*.55)) (ytop+trunc(yd*.6))
        pen (xleft+trunc(xd*.6))  (ytop+trunc(yd*.8))
        pen (xleft+trunc(xd*.7))  (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.3))  (ytop+trunc(yd*.9))
        pen (xleft+trunc(xd*.4))  (ytop+trunc(yd*.8))
        pen (xleft+trunc(xd*.45)) (ytop+trunc(yd*.6))
        pen (xleft+trunc(xd*.4))  (ytop+trunc(yd*.5))
        pen (xleft+trunc(xd*.47)) (ytop+trunc(yd*.4))
        pen (xleft+trunc(xd*.47)) (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.43)) (ytop+trunc(yd*.3))
        pen (xleft+trunc(xd*.43)) (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.47)) (ytop+trunc(yd*.2))
        pen (xleft+trunc(xd*.47)) (ytop+trunc(yd*.1))
            setfpen PieceColor
        if BFlood > 0 then flood (xleft+trunc(xd*.5)) (ytop+trunc(yd*.7))
    end
    return 1